home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / simple_c2f1.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  3.9 KB  |  156 lines
  1. C
  2. C    $Id: simple_c2f1.f,v 1.1 1993/11/16 23:36:16 idl Exp $
  3. C
  4. C NAME:
  5. C     simple_c2f1
  6. C
  7. C PURPOSE:
  8. C    This Fortran function is used to demonstrate how to pass all IDL
  9. C    simple varable types to a FORTRAN routine via a C wrapper function.
  10. C    Each variable is squared and returned to the calling C function.
  11. C
  12. C CATEGORY:
  13. C    Dynamic Link
  14. C
  15. C CALLING SEQUENCE:
  16. C      This function is called in IDL by using the following command
  17. C      Access to this function is achived via a C 'wrapper' function.
  18. C    
  19. C      IDL> result = CALL_EXTERNAL('simple_c2f.so', '_simple_c2f',    $
  20. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar, stringvar) 
  21. C
  22. C INPUTS:
  23. C
  24. C      Byte_var:       A scalar byte variable
  25. C
  26. C      Short_var:      A scalar short integer variable
  27. C
  28. C      Long_var:       A scalar long integer variable
  29. C
  30. C      Float_var:      A scalar float variable
  31. C
  32. C      Double_var:     A scalar float variable
  33. C
  34. C      String_var:     A scalar string value 
  35. C
  36. C OUTPUTS:
  37. C    The value of each variable is squared. Since you should not 
  38. C    change the value of an IDL string. A new string is created,
  39. C    two copies of the original string placed in it and the 
  40. C    string is returned as the value of this function.
  41. C
  42. C SIDE EFFECTS:
  43. C    The values of the original variables are written to stdout.
  44. C
  45. C RESTRICTIONS:
  46. C     None.
  47. C
  48. C EXAMPLE:
  49. C-----------------------------------------------------------------------------
  50. C;; The following are the commands that would be used to call this
  51. C;; routine in IDL. This calls the C function that calls this FORTRAN
  52. C;; Subprogram.
  53. C;;
  54. C        byte_var        = 1b
  55. C        short_var       = 2
  56. C        long_var        = 3l
  57. C        float_var       = 4.0
  58. C        double_var      = 5d0
  59. C        string_var      = "SIX"
  60. C
  61. C        result = CALL_EXTERNAL('simple_c2f.so', '_simple_c2f',     $
  62. C                        byte_var, short_var, long_var, float_var,            $
  63. C                        double_var, string_var )
  64. C
  65. C-----------------------------------------------------------------------------
  66. C
  67. C MODIFICATION HISTORY:
  68. C    Written October, 1993        KDB
  69.  
  70.     SUBROUTINE SIMPLE_C2F1(BYTE_VAR, SHORT_VAR, LONG_VAR,
  71.      &         FLOAT_VAR, DOUBLE_VAR, STRING_VAR, RTR_STR, RTR_LEN )
  72.  
  73. C    Declare subroutine passed in variables 
  74.  
  75.     BYTE                BYTE_VAR      !IDL byte variable
  76.  
  77.     INTEGER*2        SHORT_VAR    !IDL integer variable 
  78.     INTEGER*4        LONG_VAR    !IDL long integer
  79.     INTEGER*4        RTR_LEN
  80.  
  81.     REAL            FLOAT_VAR    !IDL float variable
  82.  
  83.     DOUBLE PRECISION    DOUBLE_VAR    !IDL double variable
  84.  
  85.     CHARACTER*(*)        STRING_VAR    !IDL string variable
  86.  
  87.     CHARACTER*(*)        RTR_STR
  88.  
  89. C    Declare local variables
  90.  
  91.     INTEGER            LN          !Length of input string
  92.     INTEGER              LEFT, EN
  93.     
  94. C    Print out each variable that was passed in.
  95.  
  96.         WRITE(*,10)
  97.  10     FORMAT(1X,/,52('-') )
  98.  
  99.         WRITE(*,20)
  100.  20     FORMAT(1X,'Inside Fortran function simple_c2f1 ',/
  101.      &     '(Called from IDL using CALL_EXTERNAL via A C function)',/)
  102.  
  103.         WRITE(*,30)
  104.  30     FORMAT(1X,'Scalar Values Passed in From IDL via a C function:')
  105.  
  106.         WRITE(*,100)BYTE_VAR
  107.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  108.  
  109.         WRITE(*,110)SHORT_VAR
  110.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  111.  
  112.         WRITE(*,120)LONG_VAR
  113.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  114.  
  115.         WRITE(*,130)FLOAT_VAR
  116.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  117.  
  118.         WRITE(*,140)DOUBLE_VAR
  119.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  120.  
  121.         WRITE(*,150)STRING_VAR
  122.  150    FORMAT(10X,'String Parameter:',T50,A)
  123.  
  124.     WRITE(*,10)
  125. C    Square each variable
  126.  
  127.     BYTE_VAR     = BYTE_VAR*BYTE_VAR
  128.     SHORT_VAR    = SHORT_VAR**2
  129.     LONG_VAR    = LONG_VAR**2
  130.     FLOAT_VAR    = FLOAT_VAR**2
  131.     DOUBLE_VAR    = DOUBLE_VAR**2
  132.  
  133. C    Now to duplicate the string
  134.  
  135.     RTR_STR = STRING_VAR
  136.  
  137.     LN = len(STRING_VAR)
  138.  
  139.     LEFT = RTR_LEN - LN    
  140.     IF( LEFT .gt. LN) LEFT = LN
  141.     
  142.     EN = LN*2
  143.     IF(EN .gt. RTR_LEN)  EN = RTR_LEN 
  144.  
  145.     RTR_STR(LN+1:EN) = STRING_VAR(1:LEFT)
  146.  
  147. C    That is all that this subroutine does. Return to the 
  148. C    calling C function.
  149.  
  150.     RETURN
  151.  
  152.     END
  153.  
  154.  
  155.  
  156.